perm filename XAP.FAI[1,BGB] blob
sn#093404 filedate 1974-03-23 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00047 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00005 00002 TITLE XAP - XEROX ASSEMBLE AND PRINT - BGB - 27 JANUARY 1973.
C00006 00003 --- ASCII 00 TO 37 CHARACTER ROUTINES.
C00008 00004 --- ASCII 40 TO 77 CHARACTER ROUTINES.
C00009 00005 --- ASCII 100 TO 137 UPPER CASE ROUTINES.
C00011 00006 --- ASCII 140 TO 177 LOWER CASE ROUTINES.
C00012 00007 GLOBAL VARIABLES.
C00014 00008 FONT SPECIFICATION.
C00016 00009 RASTER SPECIFICATIONS.
C00018 00010 ALTERNATE PDP-10 MNEMONICS.
C00021 00011 SAIL LIKE SUBROUTINE LINKAGE.
C00024 00012 START ADDRESS ENTRY.
C00025 00013 SUBR(BEGPROG) BEGIN PROGRAM.
C00027 00014 SUBR(MAIN)
C00030 00015 TWO DIMENSION BIT ADDRESSING.
C00034 00016 SUBR(XGPOUT) OUTPUT BUFFER TO XGP FROM SECONDARY STORAGE.
C00037 00017 SUBR(PRINT) PLACE A GLYPH INTO XGP BUFFER AT ROW,COL.
C00040 00018 TEXT JUSTFICATION MODES.
C00043 00019 SUBR(JUSTIFY) PRINT A JUSTIFIED PARAGRAPH OF TEXT.
C00046 00020 SUBR(LNSCAN) LINE SCAN FOR SPACES COUNT.
C00049 00021 SUBR(LNJUST) LINE JUSTIFY AND PRINT.
C00052 00022 SUBR(TJLINE) CENTER OR RIGHT JUSTIFY A LINE OF TEXT.
C00054 00023 SUBR(DEFONT) DEFINE FONT NUMERAL N TAKES N FROM AC-1.
C00056 00024 SUBR(SETFNT) SETUP A FONT, IMPLICIT ARGUMENT FONT.
C00058 00025 FONT SELECT DELIMITERS.
C00060 00026 SUBR(MKSEG0) MAKE LINE SEGMENT. CLIPPER.
C00063 00027 SUBR(MKSEG1) MAKE LINE SEGMENT.
C00066 00028 SUBR(IIISIM) OUTPUT III BUFFER ONTO XGP.
C00068 00029 FETCH AND DECODE III COMMAND WORD.
C00069 00030 EXECUTE III TEXT.
C00072 00031 EXECUTE VECTORS.
C00075 00032
C00076 00033 SUBR(VIDEO)
C00080 00034 SUBR(GETFIL) GET FILE SPECIFICATION - SKIP OK.
C00082 00035 SUBR(GETCHR) GET A CHARACTER FROM THE TEXT BUFFER.
C00084 00036 SUBR(INFILE) INDIRECT FILE COMMAND "@".
C00087 00037 COMMAND EXECUTION.
C00089 00038 XRADIAL:
C00092 00039 III DISPLAY SCALE FACTOR.
C00093 00040 SUBR(SQRT)
C00096 00041 READARC: AND REALIN.
C00099 00042 SUBR(DPYDOT)X,Y DISPLAY A DOT.
C00100 00043 SUBR(MKSEG3)
C00101 00044 SUBR(XCONIC) E<A>,<B>,<X1>,<X2>
C00103 00045 SUBR(XBOX)
C00105 00046 SUBR(XSWINE) MAKE BOX WITH ROUNDED CORNERS.
C00108 00047 SUBR(MKCURV)
C00109 ENDMK
C⊗;
TITLE XAP - XEROX ASSEMBLE AND PRINT - BGB - 27 JANUARY 1973.
; --- ASCII 00 TO 37 CHARACTER ROUTINES.
;XWD TEXT_MODE,,COMMAND_MODE
A00:
0 ;null. ;00-07.
0 ;"↓"
0 ;"α"
0 ;"β"
0 ;"∧"
0 ;"¬"
0 ;"ε"
0 ;"π"
XXLINE ;"λ" ;10↔17.
XWD %+HTAB,0 ;tab.
XWD %+LFEED,0 ;LF
0 ;VT.
XWD FFEED,FFEED ;FF.
XWD %+CRETURN,0 ;CR.
0 ;"∞"
0 ;"∂"
XWD LFS+4,DFS+4 ;"⊂" LEFT FONT SELECT DELIMITER ;20-27.
XWD RFS+4,0 ;"⊃" RIGHT FONT SELECT DELIMITER
0 ;"∩"
0 ;"∪"
0 ;"∀"
0 ;"∃"
IIISIM ;"⊗" III DISPLAY BUFFER - CORNER ORIGIN.
XARROW ;"↔"
0 ;"_" ;30-37.
XARROW ;"→"
XWD ESCTXT,ESCCOM ;"~" TILDE.
0 ;"≠"
XWD LFS+5,DFS+5 ;"≤" LEFT FONT SELECT DELIMITER
XWD RFS+5,0 ;"≥" RIGHT FONT SELECT DELIMITER
0 ;"≡"
0 ;"∨"
; --- ASCII 40 TO 77 CHARACTER ROUTINES.
;XWD TEXT_MODE,,COMMAND_MODE
XWD %+SPACE,0 ;SPACE. ;40-47.
[SETOM BUGFLG↔POPJ 17,] ;"!"
0 ;"""
0 ;"#"
0 ;"$"
0 ;"%"
0 ;"&"
0 ;"'"
XWD LFS+2,DFS+2 ;"(" LEFT FONT SELECT DELIMITER ;50-57.
XWD RFS+2,0 ;")" RIGHT FONT SELECT DELIMITER
IIISIM ;"*" III DISPLAY BUFFER - CENTER ORIGIN.
0 ;"+"
0 ;","
0 ;"-"
0 ;"."
0 ;"/"
0 ;"0" ;60-67.
0 ;"1"
0 ;"2"
0 ;"3"
0 ;"4"
0 ;"5"
0 ;"6"
0 ;"7"
0 ;"8" ;70-77.
0 ;"9~
0 ;":~
SEMICO ;";~
0 ;"<"
0 ;"="
0 ;">"
0 ;"?"
; --- ASCII 100 TO 137 UPPER CASE ROUTINES.
;XWD TEXT_MODE,,COMMAND_MODE
INFILE ;"@" INDIRECT FILE COMMAND ;100-107.
XARRLW ;"A" SET ARROW LENGTH,WIDTH
XBOX ;"B"
XCONIC ;"C" CONIC ARCS
XDIAMON ;"D" DEBUG FLAG.
XCONIC ;"E"
XFONT ;"F" SELECT FONT AND ENTER TEXT MODE.
0 ;"G"
XCONIC ;"H" ;110-117.
AI ;"I" ABSOLUTE INVISIBLE VECTOR.
XJUSTM ;"J"
0 ;"K"
XLOCUS ;"L"
DEFONT ;"M" MAKE A FONT NUMBER.
0 ;"N"
XROTAT ;"O" SET ORIENTATION.
0 ;"P" ;120-127.
FFEED ;"Q"
XRADIAL ;"R"
XSWINE ;"S" MAKE ROUNDED BOX.
0 ;"T"
0 ;"U"
AV ;"V" ABSOLUTE VISIBLE VECTOR.
XWINDO ;"W"
XXSCAL ;"X" SET X SCALE. ;130-137.
YYSCAL ;"Y" SET Y SCALE.
0 ;"Z"
XWD LFS+3,DFS+3 ;"[" LEFT FONT SELECT DELIMITER
0 ;"\"
XWD RFS+3,0 ;"]" RIGHT FONT SELECT DELIMITER
0 ;"↑"
XARROW ;"←"
; --- ASCII 140 TO 177 LOWER CASE ROUTINES.
;XWD TEXT_MODE,,COMMAND_MODE
0 ;"'" ;140-147.
0 ;"a"
0 ;"b"
0 ;"c"
0 ;"d"
0 ;"e"
0 ;"f"
0 ;"g"
0 ;"h" ;150-157.
0 ;"i"
0 ;"j"
0 ;"k"
MUZAV ;"l" ;AV which uses co-ordinates as in Locus
0 ;"m"
0 ;"n"
0 ;"o"
0 ;"p" ;160-167.
0 ;"q"
0 ;"r"
0 ;"s"
0 ;"t"
0 ;"u"
0 ;"v"
0 ;"w"
0 ;"x" ;170-177.
0 ;"y"
0 ;"z"
XWD LFS+1,DFS+1 ;"{" LEFT FONT SELECT DELIMITER
0 ;"|"
0 ;alt
XWD RFS+1,0 ;"}" RIGHT FONT SELECT DELIMITER
0 ;rubout
;GLOBAL VARIABLES.
;JOB DATA AREA AND CORE MAP.
PDL: BLOCK 100 ;CONTROL PUSH DOWN.
PDLLEN←←.-PDL
PAT: BLOCK 100 ;PATCH AREA.
EXTERN JOBJDA ;140 END OF JOB DATA AREA.
EXTERN JOBFF ;121 TOP OF USED CORE POINTER.
EXTERN JOBSA ;120 XWD ORGINAL-TOP,START-ADDR.
EXTERN JOBREL ; 44 PHYSICAL TOP OF CORE IMAGE.
;PROCESSOR STATUS.
PASS: 0 ; 0 FOR PASS1, -1 FOR PASS2.
CMODE: 0 ;-1 COMMAND MODE. 0 TEXT MODE.
CHAR: 0 ;CURRENT CHARACTER.
CHRCNT: 0 ;CHARACTERS REMAINING.
ESC: 32 ;ESCAPE CHARACTER - DEFAULT TILDE.
TXTPTR: 0 ;TEXT POINTER.
TXTORG: 0 ;TEXT ORIGIN.
TXTEND: 0 ;END OF TEXT BUFFER.
XLINE: 5 ;EXTRA LINES BETWEEN ROWS OF CHARACTERS
EOF:0↔HIDDEN:0
EOP:0 ;END OF PAGE FLAG.
BUGFLG:0 ;-1 WHEN DEBUGGING.
;DSK I/O DATA AREA.
FILNAM: 0 ;FILE NAME.
EXTION: 0↔0 ;EXTENSION.
PPPN: 0↔0 ;PROJECT-PROGRAMMER.
;FONT SPECIFICATION.
FONT: 1
FONTAB: BLOCK =45
FNTPPN: SIXBIT/XGPSYS/ ;DEFAULT FONT PPN
;DEFAULT FONT NUMERAL NAMES.
FNTNAM: 0 ;0 "RON ZIEGLER" FONT.
SIXBIT/LPT/ ;1 LINE PRINTER.
SIXBIT/FIX13X/ ;2 FIXED WIDTH FONTS.
SIXBIT/FIX20/ ;3
SIXBIT/FIX25/ ;4
SIXBIT/FIX30/ ;5
SIXBIT/FIX40/ ;6
SIXBIT/NGR13/ ;7 NEW GOTHIC ROMAN.
SIXBIT/NGR20/ ;8
SIXBIT/NGR25/ ;9
SIXBIT/NGR30/ ;A
SIXBIT/NGR40L/ ;B
SIXBIT/BDR25/ ;C BODONI ROMAN
SIXBIT/BDI25/ ;D BODONI ITALIC
SIXBIT/XMAS25/ ;E PSEUDO OLDE ENGLISH.
SIXBIT/SIGN57/ ;F
SIXBIT/GRK25/ ;G GREEK.
SIXBIT/SET1/ ;H TOVAR'S CREATION.
SIXBIT/SUB/ ;I
SIXBIT/SUP/ ;J
BLOCK ("Z"-"H") ;TO Z - EMPTY SPACE.
COMMENT ⊗ STANFORD FONT FILE FORMAT.---------------------------------
WORDS 0-177:
XWD CHARACTER_WIDTH,CHARACTER_ADDRESS
WORDS 200-237:
CHARACTER_SET_NUMBER
HEIGHT
MAX_WIDTH (IN BITS)
BASE LINE (BITS FROM TOP OF CHARACTER)
WORDS 240-377:
ASCIZ/FONT DESCRIPTION/
REMAINDER OF FILE:
EACH CHARACTER:
CHARACTER_CODE,,WORD_COUNT+2
ROWS_FROM_TOP,,DATA_ROW_COUNT
BLOCK WORD_COUNT
--------------------------------------------------------------------⊗
;RASTER SPECIFICATIONS.
;XGP RASTER PAGE BUFFER.
ROW:0 ;XGP "PEN" POSITION.
COL:0
DROW:0 ;DELTA PEN POSITION FOR LINE FEED AND SPACE.
DCOL:0
QPAGE:0 ;QUARTER PAGE: 0, 1, 2, 3.
QLO:0↔QHI:0 ;QUARTER ROW LOW & QUARTER ROW HI.
ORGXGP:0 ;XGP BUFFER (1/4 OF A PAGE).
ENDXGP:0
;XGP RASTER DIMENSIONS.
WWIDTH←←=49 ;WORD WIDTH OF A ROW.
NCOLS←←(WWIDTH-1)*=36 ;NUMBER OF COLUMNS IS 1728.
MROWS←←=2048 ;NUMBER OF ROWS IS 2048.
BUFSIZ←←WWIDTH*MROWS/4 ;SIZE OF XGP BUFFER (ONE QUARTER PAGE).
;III BUFFER DISPLAY.
IIIDX: =1024
IIIDY: =1024
ROTDEL:0
SINE:0↔COSINE:1.0 ;ORIENTATION.
SCALEX:1.0↔SCALEY:1.0 ;DILATION.
;TEXT JUSTIFICATION PARAMETERS.
COLMIN:↔LMAR: =200 ;OF 1728 COLUMNS.
COLMAX:↔RMAR: =1500
ROWMIN: =200 ;OF 2048 ROWS.
ROWMAX: =2000
TJMODE: -1 ;AUTO CRLF MODE.
TJFLAG: 0 ;-1 CENTER, +1 RIGHT JUSTIFICATION.
;ALTERNATE PDP-10 MNEMONICS.
DEFINE O(A,B){OPDEF A[B]}
O LIP,HLR↔O LAP,HRR↔O DIP,HRLM↔O DAP,HRRM
O ZIP,HRRZS↔O ZAP,HLLZS↔O WIP,HRROS↔O WAP,HRRZS
O CAR,HLRZ↔O LIPI,HRLI↔O LAPI,HRRI↔O DIPZ,HRLZM
O CDR,HRRZ↔O LACI,MOVEI↔O SLACI,MOVSI↔O DAPZ,HRRZM
O LAC,MOVE↔O LACN,MOVN↔O LACM,MOVM↔O SLAC,MOVS
O DAC,MOVEM↔O DACN,MOVNM↔O DACM,MOVMM↔O SDAC,MOVSM
O NIP,HLRE↔O NAP,HRRE↔O NIM,HRREI↔O GO,JRST
O FLOAT,FSC 233↔O FIXX,FIX 233000↔O DZM,SETZM↔O DOM,SETOM
O JCALL,JRST↔O ZAC,SETZ↔O WAC,SETO
;MAKE RAID KNOW THE FOLLOWING
O(FIX,FIX)↔O(HALT,HALT)
O(INCHRW,INCHRW)↔O(INCHWL,INCHWL)
O(OUTCHR,OUTCHR)↔O(OUTSTR,OUTSTR)
O(JRSTF,{JRST 2,})↔O(JCALL,{JRST 1,})↔O(PGCLR,{PGIOT 2,})
;RETURN FROM AN N-ARGUMENT SUBROUTINE CALL.
↓P←←17↔DEFINE POP0J <POPJ P,>
↓POP1J.:SUB P,[2(2)]↔GO@2(P)↔DEFINE POP1J<GO POP1J.>
↓POP2J.:SUB P,[3(3)]↔GO@3(P)↔DEFINE POP2J<GO POP2J.>
↓POP3J.:SUB P,[4(4)]↔GO@4(P)↔DEFINE POP3J<GO POP3J.>
↓POP4J.:SUB P,[5(5)]↔GO@5(P)↔DEFINE POP4J<GO POP4J.>
;MACROS TO SAVE AND RESTORE AC'S - SAVAC, GETAC, PUSHACS, POPACS.
DEFINE SAVAC $(N){LAC[XWD 2,AC2]↔BLT AC$N}
DEFINE GETAC (N){LAC[XWD AC2,2]↔BLT N}
IFNDEF PUSHIT<
DEFINE PUSHACS<PUSHJ P,PUSHIT↑
GLOBAL .PLEVEL↔.PLEVEL←←.PLEVEL+20>
DEFINE POPACS<PUSHJ P,POPIT↑
GLOBAL .PLEVEL↔.PLEVEL←←.PLEVEL-20>>
;ACCUMULATOR AND TEMPORARY DATA MANAGEMENT.
DEFINE ACCUMULATORS(LIST){ACPTR←←2
FOR AC⊂(LIST)<AC←ACPTR↔ACPTR←←ACPTR+1↔>}
DEFINE DECLARE (LIST){
FOR VARNAM⊂(LIST)<VARNAM: 0↔>}
;FATAL ERROR MESSAGE.
DEFINE FATAL(STR){PUSHJ 17,FATAL.↔ASCIZ/STR/}
FATAL.:OUTSTR[BYTE(7)15,12(21)"FAT"↔"AL - "⊗1↔0]
OUTSTR @(17)↔INCHRW↔GO .-1↔LIT
DEFINE CRLF{OUTSTR[BYTE(7)15,12]}
%←←400000
;SAIL LIKE SUBROUTINE LINKAGE.
DEFINE ARG1<-1(P)>↔DEFINE ARG2<-2(P)>
DEFINE ARG3<-3(P)>↔DEFINE ARG4<-4(P)>
DEFINE CAT $(A,B){A$B} ;CONCATENATION.
.PLEVEL←←0 ;PDL BACK POINTER.
.SLEVEL←←0 ;DEPTH OF NESTED SUBROUTINE DECLARATIONS.
;SUBROUTINE DECLARATION MACROS - SUBR & ENDR.
;(Reminder: Right-arrow, "→" is FAIL's macro arg EVAL).
DEFINE SUBR(NAME,X1,X2,X3,X4,X5)↔{BEGIN NAME↔INTERN NAME
GLOBAL .PLEVEL↔GLOBAL .SLEVEL↔.SLEVEL←←.SLEVEL+1
CAT(.SBR,→.SLEVEL)←←.PLEVEL ↔.PLEVEL←←.PLEVEL+1
IFDIF<><X1>{DEFARG(X1,→.PLEVEL) ↔.PLEVEL←←.PLEVEL+1
IFDIF<><X2>{DEFARG(X2,→.PLEVEL) ↔.PLEVEL←←.PLEVEL+1
IFDIF<><X3>{DEFARG(X3,→.PLEVEL) ↔.PLEVEL←←.PLEVEL+1
IFDIF<><X4>{DEFARG(X4,→.PLEVEL) ↔.PLEVEL←←.PLEVEL+1
IFDIF<><X5>{DEFARG(X5,→.PLEVEL) ↔.PLEVEL←←.PLEVEL+1}}}}}
XWD 777000+.PLEVEL-CAT(.SBR,→.SLEVEL)-1,[SIXBIT|NAME|]↔↓NAME:;}
;DEFINE ARGUMENT NAME MACRO.
DEFINE DEFARG(NAME,LEVEL){DEFINE NAME{LEVEL-.PLEVEL(17)}}
;SUBROUTINE TERMINATION MACRO.
DEFINE ENDR{.PLEVEL←←CAT(.SBR,→.SLEVEL)
.SLEVEL←←.SLEVEL-1↔LIT↔BLOCK 0↔BEND }
;SUBROUTINE CALLING MACROS - CALL & SETQ.
DEFINE CALL(NAME,X1,X2,X3,X4,X5)
{GLOBAL .SLEVEL,.PLEVEL↔.SLEVEL←←.SLEVEL+1
CAT(.SBR,→.SLEVEL)←←.PLEVEL
IFDIF<><X1>{PUSH P,X1↔.PLEVEL←.PLEVEL+1
IFDIF<><X2>{PUSH P,X2↔.PLEVEL←.PLEVEL+1
IFDIF<><X3>{PUSH P,X3↔.PLEVEL←.PLEVEL+1
IFDIF<><X4>{PUSH P,X4↔.PLEVEL←.PLEVEL+1
IFDIF<><X5>{PUSH P,X5↔.PLEVEL←.PLEVEL+1 }}}}}
IFDIF<><NAME>{PUSHJ P,NAME }
.PLEVEL←←CAT(.SBR,→.SLEVEL)↔.SLEVEL←←.SLEVEL-1}
DEFINE SETQ(VAR,LIST){CALL(LIST)↔DAC 1,VAR}
;STACK ACCESSING MACROS - PUSHP & POPP.
DEFINE PUSHP(ARG){PUSH P,ARG↔.PLEVEL←←.PLEVEL+1}
DEFINE POPP(ARG) {POP P,ARG↔.PLEVEL←←.PLEVEL-1}
;START ADDRESS ENTRY.
SA: CALLI
CAR JOBSA↔DAC JOBFF↔CORE↔JFCL ;CORE DOWN LOWER.
LACI =2047↔CORE2↔GO[
FATAL(<CAN'T GET A 2ND SEGMENT.>)]
LAC P,[IOWD PDLLEN,PDL] ;CONTROL PUSHDOWN.
;RE-ENTRY ADDRESS.
REE: LACI .↔DAC 124
LAC P,[IOWD PDLLEN,PDL] ;CONTROL PUSHDOWN.
;EXECUTION.
CALL(BEGPROG) ;PROGRAM INITIALIZATION.
CALL(MAIN) ;MAIN PROGRAM EXECUTION.
;END PROGRAM.
CALLI ;FLUSH THE TWO LIBRASCOPE BANDS.
LAC JOBFF↔CORE↔JFCL ;FLUSH THE 25K TO 50K OF EXTRA CORE.
SETZ↔CORE2↔JFCL ;FLUSH UPPER SEGMENT OF FONT FILES.
EXIT
;--------------------------------------------------------------------
SUBR(BEGPROG) ;BEGIN PROGRAM.
;--------------------------------------------------------------------
LACI 0↔UFBGET↔GO .+3
LACI 1↔UFBGET↔GO[FATAL(<CAN'T GET FASTBANDS.>)]
;DEFAULT INITIALIZE MARGINS.
LAC ROWMIN↔DAC ROW ;XGP PEN POSITION.
LAC COLMIN↔DAC COL
;INITIALIZE SCANNER AND CORE ALLOCATION.
DOM CMODE ;COMMAND MODE.
CALL(MKBUF) ;MAKE XGP BUFFER.
CALL(MKTABL) ;MAKE 2D BIT ADDRESS TABLE.
;DEFINE DEFAULT FONT.
DZM FONTAB
LAC[XWD FONTAB,FONTAB+1]↔BLT FONTAB+9
LAC[SIXBIT/LPTFNT/]
HLLZM FILNAM↔DIPZ EXTION
LAC FNTPPN↔DAC PPPN
LACI 1↔DAC FONT
CALL(<DEFONT+1>)
;RESCAN COMMAND LINE FOR CHARACTERS RIGHT OF SEMI-COLON.
RESCAN↔INCHSL↔EXIT↔CAIN 15↔EXIT
CAIE";"↔GO .-5↔DZM CHRCNT
CDR JOBFF↔LIPI 440700 ;TEXT BUFFER POINTER.
DAC TXTPTR↔DAC TXTORG
INCHSL 1↔EXIT ;READ FIRST CHARACTER.
DZM BUGFLG↔CAIN 1,"!"
DOM BUGFLG↔GO .+3
INCHSL 1↔GO .+4↔AOS CHRCNT ;READ REMAINING CHARACTERS.
IDPB 1,0↔GO .-4↔DAC TXTEND
SKIPN BUGFLG↔POP0J
OUTSTR[ASCIZ/BEGIN./]
INCHRW↔CRLF↔POP0J
ENDR BEGPROG;--------------------------------------------------------
SUBR(MAIN)
;--------------------------------------------------------------------
;START-OF-DOCUMENT.
LAC TXTORG↔DAC TXTPG#↔DZM EOF
CDR 1,TXTEND↔CDR 0,TXTORG
SUB 1,0↔AOS 1↔IMULI 1,5↔DAC 1,CHRCNT
LAC CHRCNT↔DAC SAVCNT
;START-OF-PAGE.
L0: LACI =511↔DAC QHI↔DZM QLO↔DZM QPAGE ;1ST QUARTER PAGE.
L00: LAC TXTPG↔DAC TXTPTR↔DZM EOP
DOM CMODE↔DZM EOF ;TOP-OF-THE-PAGE.
LAC SAVCNT↔DAC CHRCNT
LAC ROWMIN↔DAC ROW
LAC COLMIN↔DAC COL
LAC ORGXGP↔DZM@↔DIP↔AOS↔BLT@ENDXGP ;CLEAR QUARTER PAGE.
;PROCESS A CHARACTER.
L1: SKIPE EOP↔GO L3 ;END OF PAGE ?
SETQ(CHAR,{GETCHR}) ;FETCH A CHARACTER.
SKIPE EOF↔GO L3 ;END OF DOCUMENT DOCUMENT ?
SKIPE CMODE↔GO L2 ;TEXT OR COMMAND MODE ?
CAR 0,A00(1)↔TRZ %↔JUMPE 0,.+3 ;TEXT MODE CHARACTER.
CALL(@0)↔GO L1 ;TEXT MODE SUBROUTINES.
CALL(PRINT)↔GO L1 ;PRINT UNJUSTIFIED CHARACTER.
L2: CDR A00(1) ;COMMAND MODE CHARACTER.
SKIPE↔PUSHJ P,@0↔GO L1 ;EXECUTE A COMMAND.
;WRITE QUARTER OF A PAGE ON LIBRASCOPE.
L3: LAC 1,QPAGE↔LAC[0↔=784↔=1568↔0](1)↔DAC SECTOR
LAC ORGXGP↔DAC BUFPTR↔ LACI =25088↔DAC WRDCNT
LAC[0↔0↔0↔1](1)↔DAC BAND
FBWRT BUFPTR↔OUTSTR[ASCIZ/WARNING: FB WRITE ERROR./]
;ADVANCE TO NEXT QUARTER PAGE.
LACI =512↔ADDM QLO↔ADDM QHI
AOS 1,QPAGE↔CAIGE 1,4↔GO L00
;ADVANCE TO NEXT PAGE.
L4: CALL(XGPOUT)
L4A: CRLF
LAC TXTPTR↔DAC TXTPG
LAC CHRCNT↔DAC SAVCNT
SKIPN EOF↔GO L0
POP0J
ENDR MAIN;-----------------------------------------------------------
SAVCNT:0
;TWO DIMENSION BIT ADDRESSING.
DEFINE DOT(R,C){HLLZ 1,%(C)↔ROT 1,6↔HRRI 1,@%(R)↔DPB 0,1}
COMMENT ⊗
The DOT macro places a bit at a given row and column of the
XGP buffer. The 2D bit address byte pointer is computed by twice
referencing a 2K table in which the Nth word contains the bytes
0:5(N div =36) 6:11(N mod =36) 12:17(01) 18:35(orgXGP+N*WWIDTH).
That is the left halfword of the Nth table entry contains the base
address of the Nth row; and the right halfword of the Nth table
entry contains a byte pointer to the Nth column. In the DOT macro,
the HLLZ and ROT instructions setup the column byte pointer and the
HRRI instruction (thru the magic of immediate indirect double
indexing) adds the right halfword of the Nth row table entry to the
byte pointer. The use of accumulator 1 is mandatory because of the
index-byte-size pun. The following subroutine initializes the table.⊗
SUBR(MKTABL) ;MAKE 2D BIT ADDRESSING TABLE IN 2ND SEGMENT.
;--------------------------------------------------------------------
LAC[XWD L,1]↔BLT 11
LAC ORGXGP↔AOS↔TLO 4301↔PUSHJ P,3
LAP ORGXGP↔AOS↔LIPI 2,-=512↔PUSHJ P,3
LAP ORGXGP↔AOS↔LIPI 2,-=512↔PUSHJ P,3
LAP ORGXGP↔AOS↔LIPI 2,-=512↔GO 3
L: XWD -100,WWIDTH ;1 INCREMENT.
XWD -=512,% ;2 AOBJN TABLE POINTER.
DAC 0,(2) ;3
TLNN 0,7700 ;4 TEST FOR =36 OVERFLOW.
ADD 0,[144B11] ;5 INCREMENT COLUMN WORD COUNT.
ADD 0,1 ;6
AOBJN 2,3 ;7
POP0J ;8
ENDR MKTABL;BGB 24 MAY 1973._________________________________________
SUBR(MKBUF) MAKE XGP BUFFER (ONE PHASE) 512 ROWS.
;--------------------------------------------------------------------
;EXPAND CORE FOR XGP BUFFER.
CDR JOBFF↔DAC ORGXGP
ADDI BUFSIZ-1↔DAC ENDXGP
ADDI 3*WWIDTH+10↔DAC JOBFF↔ADDI =3000
CORE↔GO[FATAL(CAN'T GET CORE FOR XGP BUFFER)]
;CLEAR XGP BUFFER.
LAC 1,ORGXGP↔SETZM(1)
DIP 1,1↔AOS 1↔BLT 1,@JOBREL
POP0J
ENDR MKBUF;BGB 27 JANUARY 1973.-----------------------------------
SUBR(XGPOUT) OUTPUT BUFFER TO XGP FROM SECONDARY STORAGE.
;--------------------------------------------------------------------
BSIZ ←← =6272 ↔ BCNT ←← =16 ;BUFFER SIZE & NUMBER OF THEM.
SETZ 1,↔SEGNUM 1,↔DAC 1,MYSEG#↔DETSEG ;DETACH SEGMENT.
L0: INIT 2,117↔SIXBIT/XGP/↔0↔GO[OUTSTR[ASCIZ/XGP INIT FAILED.
/]↔ POP0J]↔LOCK
OUTSTR[ASCIZ/PAGE TO XGP.../]
LAC ORGXGP↔DAC BUFORG ;SETUP AN OUTPUT BUFFER.
ADDI 3*BSIZ↔DAC BUFEND
CAMLE JOBREL↔CORE↔JFCL
DZM BAND↔DZM SECTOR ;FIRST BAND AND SECTOR.
LAC BUFORG↔DAC BUFPTR
LACI 3,BCNT ;DRUM BUFFERS PER PAGE.
;READ DRUM.
L1: LACI BSIZ↔DAC WRDCNT↔LAC BAND
FBREAD BUFPTR↔OUTSTR[ASCIZ/FAST BAND READ ERROR. /]
LACI =196↔ADDB SECTOR↔CAIG =2156↔GO .+3↔DZM SECTOR↔AOS BAND
;PUT XGP CONTROL WORD IN EACH ROW.
LAC[1B11+=48]↔LAC 1,BUFPTR↔LACI 2,=128
DAC(1)↔ADDI 1,=49↔SOJG 2,.-2
CAIE 3,BCNT↔GO L2
OUT 2,CUT1
;PRINT ON XGP.
L2: SLACI -BSIZ↔LAP BUFPTR↔SOS↔ASH 3,1↔DAC DUMARG(3)
OUT 2,DUMARG(3)↔STATZ 2,2000↔GO[
OUTSTR[ASCIZ/XGP LOSSAGE, TRY AGAIN ?
/]↔RELEASE 2,↔UNLOCK↔INCHRW↔caie"y"↔CAIN"Y"↔GO L0↔GO L5]
ASH 3,-1↔CAIE 3,1↔GO L3
OUT 2,CUT2
;ADVANCE TO NEXT BUFFER.
L3: LACI BSIZ↔ADDB BUFPTR↔CAMGE BUFEND↔GO L4
LAC BUFORG↔DAC BUFPTR
L4: SOJG 3,L1↔UNLOCK↔RELEASE 2,↔OUTSTR[ASCIZ/FINISHED./]
L5: CRLF↔LAC 1,MYSEG↔JUMPE 1,.+3 ;RE-ATTACH SEGMENT.
ATTSEG 1,↔GO[OUTSTR[ASCIZ/ATTSEG FAILED. /]↔HALT .+1]
POP0J
;--------------------------------------------------------------------
BUFORG:0↔BUFEND:0 ;XGP BUFFERS.
DUMARG:BLOCK BSIZ*2 + 4
CUT1: IOWD 3,HACK1↔0
CUT2: IOWD 2,HACK2↔0
HACK1: 1B0 ↔ =75B11 ↔ 0 ;CUT AT THE TOP AND THEN MOVE.
HACK2: =75B11 ↔ 1B0 ↔ 0 ;MOVE AND THEN CUT AT THE BOTTOM.
ENDR XGPOUT;BGB 28 MAY 1973.--------------------------------------
BAND:0↔BUFPTR:0↔WRDCNT:=12544↔SECTOR:0 ;FB UUO ARGUMENT.
SUBR(PRINT) PLACE A GLYPH INTO XGP BUFFER AT ROW,COL.
;--------------------------------------------------------------------
;Implicit Arguments to PRINT are ROW, COL, CHAR,
;FONT, FONTAB, ORGXGP, ENDXGP, TJMODE.
ACCUMULATORS{G,B,B2,M,N,I,X16}
SKIPN CHAR↔POP0J ;IGNORE NULL CHARACTERS.
LAC 1,FONT ;CURRENT FONT NUMBER.
SKIPN 2,FONTAB(1)↔POP0J ;FONT BASE ADDRESS.
LAC I,203(2) ;ROWS BETWEEN TOP AND BASE LINE.
ADD 2,CHAR ;POINTER INTO FONT'S CHARACTER TABLE.
CAR N,(2) ;COLS WIDE OF THE GLYPH.
CDR G,(2)↔SKIPN G↔POP0J ;EXIT WHEN NO CHARACTER.
ADD G,FONTAB(1)↔AOS G ;CHARACTER'S GLYPH POINTER.
CDR M,(G) ;ROWS HIGH OF THE GLYPH.
CAR 0,(G) ;ROWS FROM TOP TO FIRST ROW OF GLYPH.
SUB 0,I ;ROWS ABOVE CURRENT XGP PEN POSITION.
ADD 0,ROW↔SUB 0,QLO
IMULI WWIDTH
ADD ORGXGP↔DAPZ B ;WORD POINTER INTO XGP BUFFER.
LAC 0,COL
SKIPE TJMODE↔GO .+3 ;CLIP LINE OVERFLOW IF TJMODE=0
CAML 0,RMAR↔POP0J
IDIVI 0,=36 ;REMAINDER IN AC-1 !
AOS↔ADD B,0↔DAC B,B2 ;WORD POINTER INTO XGP BUFFER.
ADDM N,COL ;UPDATE XGP PEN COLUMN POSITION.
TLO G,444400↔AOS G ;SETUP GLYPH BYTE POINTER.
CAILE N,=36↔GO[
IDIVI N,=36↔AOJA N,L0] ;WHEN CHARACTER WIDTH ≥ =36.
DPB N,[POINT 6,G,11] ;SIZE OF BYTE.
ADD 1,N↔SUBI 1,=36 ; =36 - CHRWID - REMAINDER
LACI N,1
L0: MOVNS 1↔DAP 1,L3 ;BYTE POSITION WITH RESPECT TO WORD BOUNDARYS.
;INCLUSIVE OR GLYPH BITS INTO THE XGP BUFFER.
L1: LAC I,N
L2: ILDB 0,G↔SETZ 1,
L3: LSHC 0,0
CAML B,ORGXGP↔CAMLE B,ENDXGP↔SKIPA↔IORM 0,(B)
AOS B↔JUMPE 1,L4
CAML B,ORGXGP↔CAMLE B,ENDXGP↔SKIPA↔IORM 1,(B)
L4: SOJG I,L2↔LAC B,B2
ADDI B,WWIDTH↔DAC B,B2
SOJG M,L1
POP0J
ENDR PRINT;5/23/73(BGB)----------------------------------------------
;TEXT JUSTFICATION MODES.
;TJMODES: ;-1 JA AUTO CRLF DEFAULT.
; 0 JV VIDEO CLIPPED MODE.
;+1 JU JUSTIFY MODE.
;TJFLAG: ;-1 JC CENTER JUSTIFY A LINE.
;+1 JR RIGHT JUSTIFY A LINE.
;EXECUTE "J" COMMAND.------------------------------------------------
XJUSTM: CALL(GETCHR)↔LACI 1
CAIN 1,"A"↔DOM TJMODE ;JUSTIFY AUTOMATIC CRLF.
CAIN 1,"V"↔DZM TJMODE ;JUSTIFY VIDEO.
CAIN 1,"U"↔DAC TJMODE ;JUSTIFY.
CAIN 1,"C"↔DOM TJFLAG ;JUSTIFY CENTER.
CAIN 1,"R"↔DAC TJFLAG ;JUSTIFY RIGHT.
POP0J
;--------------------------------------------------------------------
SPACE:
LAC 1,FONT ;THE FONT.
SKIPN 1,FONTAB(1)↔HALT
CAR 0," "(1) ;THE WIDTH OF A SPACE.
ADDM 0,COL ;NEW CARRIAGE POSITION.
POP0J
CRETURN:
LAC 1,COLMIN
DAC 1,COL
POP0J
LFEED:
LAC 1,FONT
SKIPN 1,FONTAB(1)↔HALT
LAC 1,201(1) ;MAXIMUM HEIGHT.
ADD 1,XLINE
ADDM 1,ROW
POP0J
HTAB:
LAC 1,FONT ;THE FONT.
SKIPN 1,FONTAB(1)↔HALT
CAR 0," "(1) ;THE WIDTH OF A SPACE.
LAC 1,COL↔SUB 1,COLMIN ;CARRIAGE POSITION.
IDIV 1,0↔ANDCMI 1,7 ;THE OCTADE OF THE NUMBER OF SPACES.
ADDI 1,8 ;NEXT OCTADE.
IMUL 1,0 ;NEW CARRIAGE POSITION.
ADD 1,COLMIN↔DAC 1,COL
SKIPLE TJMODE ;SKIP WHEN MODE IS -1 OR 0.
JCALL JUSTIFY
POP0J
ESCTXT: DOM CMODE↔POP0J ;ESCAPE TEXT - ENTER COMMAND MODE.
ESCCOM: DZM CMODE
POP0J ;ESCAPE COMMAND - ENTER TEXT MODE.
FFEED: DOM EOP↔POP0J
XXLINE: CALL(REALIN)↔FIXX↔DACM XLINE↔POP0J
XWINDO: CALL(REALIN)↔FIXX↔DACM COLMIN
CALL(REALIN)↔FIXX↔DACM COLMAX↔POP0J
SUBR(JUSTIFY) ;PRINT A JUSTIFIED PARAGRAPH OF TEXT.
COMMENT ⊗------------------------------------------------------------
A justified paragraph begins with a TAB and ends with one of
five possible terminations: 1. end of file; 2. escape character;
3. form feed; 4. CRLF-TAB; 5. CRLF-CRLF. The main role of this routine
is to find the end of the paragraph; then it calls LNSCAN and LNJUST
until all the full lines are printed.
;-------------------------------------------------------------------⊗
PUSH P,TXTPTR ;SAVE INITIAL STATE OF THE SCANNER.
PUSH P,CHRCNT
L1: LAC TXTPTR↔DAC ENDPTR ;SAVE PTR TO POTENTIAL END CHARACTER.
CALL(GETCHR)
SKIPE EOF↔GO L2 ;1. END OF FILE EXCLUSIVE.
CAMN 1,ESC↔GO L2 ;2. ESCAPE CHARACTER EXCLUSIVE.
CAIN 1,14 ↔GO L2 ;3. FORM FEED EXCLUSIVE.
CAIE 1,15 ↔GO L1 ;SKIP ON 1ST CARRIAGE RETURN.
;CARRIAGE RETURN LOOK AHEAD.
LAC 0,TXTPTR
ILDB 1,0↔CAIE 1,12↔GO L1 ;LINE FEED INCLUSIVE.
DAC 0,ENDPTR
ILDB 1,0↔CAIN 1,11↔GO L2 ;4. CRLF TAB.
CAIE 1,15↔GO L1 ;2ND CARRIAGE RETURN.
ILDB 1,0↔CAIE 1,12↔GO L1 ;5. CRLF CRLF.
;FOUND END OF PARAGRAPH (INCLUSIVE AND EXCLUSIVE).
L2: POP P,CHRCNT ;RESTORE SCANNER TO INITIAL POSITION.
POP P,TXTPTR
;PRINT ALL THE FULL LINES OF THE PARAGRAPH.
L3: CALL(LNSCAN) ;LINE SCAN FOR SPACES.
CALL(LNJUST) ;LINE JUSTIFY AND PRINT.
LAC TXTPTR↔CAME ENDPTR↔GO L3 ;TEST FOR END OF PARAGRAPH.
POP0J
;BYTE POINTER TO LAST CHARACTER OF THE PARAGRAPH INCLUSIVE.
↑ENDPTR: 0 ;IMPLICIT ARGUMENT FOR LNSCAN.
ENDR JUSTIFY;9/20/73(BGB)--------------------------------------------
SUBR(LNSCAN) ;LINE SCAN FOR SPACES COUNT.
COMMENT ⊗------------------------------------------------------------
Scan for left margin overflow, while keeping track of the
number of spaces seen and the position of the last space seen.
--------------------------------------------------------------------⊗
ACCUMULATORS{CHR}
;INITIALIZATION.
LAC COL↔DAC COLUMN ;TJ LEFT MARGIN.
DZM SPACNT↔DZM SPAPTR↔DZM SPACOL
LAC TXTPTR↔DAC LNPTR
DZM SPAFLG ;IGNORE LEADING SPACES.
;TEST FOR END OF LINE SCAN.
L1: LAC LNPTR↔CAMN ENDPTR↔GO[ ;EXIT END OF PARAGRAPH.
DZM SPAPTR↔DZM SPACNT↔POP0J]
LAC COLUMN↔CAML COLMAX↔POP0J ;EXIT LINE FULL.
;FETCH A CHARACTER.
ILDB CHR,LNPTR
CAIN CHR,12↔GO L1 ;IGNORE LINEFEEDS.
CAIN CHR,00↔GO L1 ;IGNORE NULLS.
CAIN CHR,11↔LACI CHR,40 ;CONVERT TAB INTO A SPACE.
CAIN CHR,15↔LACI CHR,40 ;CONVERT CR INTO A SPACE.
;SAVE THE STATUS OF THE LATEST SPACE.
CAIE CHR,40↔GO L2
AOSE SPAFLG↔GO L1 ;IGNORE MULTIPLE SPACES.
AOS SPACNT ;INCREMENT SPACE COUNT.
LAC COLUMN↔DAC SPACOL ;SAVE SPACE POSITION.
LAC LNPTR↔DAC SPAPTR ;SAVE SPACE BYTE POINTER.
LAC 1,FONT↔LAC 1,FONTAB(1) ;FONT BASE ADDRESS.
ADD 1,CHR↔CAR 0,(1) ;WIDTH OF SPACE.
SKIPE DOUBLE↔ASH 0,1 ;DOUBLE WIDTH SPACE.
ADDB 0,COLUMN↔GO L1
;ACCUMULATE CHARACTER WIDTHS - NOT SPACE.
L2: DOM SPAFLG#↔DZM DOUBLE#
CAIN CHR,"."↔DOM DOUBLE
CAIN CHR,"?"↔DOM DOUBLE
LAC 1,FONT↔LAC 1,FONTAB(1) ;FONT BASE ADDRESS.
ADD 1,CHR↔CAR 0,(1) ;WIDTH OF CHARACTER.
ADDB 0,COLUMN↔GO L1
;GLOBAL VARIABLES FOR COMMUNICATION TO LNJUST.
↑LNPTR: 0 ;END OF LINE POINTER.
↑SPACNT:0 ;SPACE COUNT.
↑SPAPTR:0 ;BYTE POINTER TO LATEST SPACE.
↑SPACOL:0 ;COLUMN POSITION OF LATEST SPACE.
COLUMN: 0 ;LOOK AHEAD COLUMN POSITION.
ENDR LNSCAN;9/20/73(BGB)---------------------------------------------
SUBR(LNJUST) ;LINE JUSTIFY AND PRINT.
;IMPLICIT ARGUMENTS:
PTR←←14
LAC COLMAX↔SUB SPACOL↔DAC EXTRA ;EXTRA SPACE.
SKIPLE SPACNT↔SOS SPACNT↔DZM SPAFLG ;IGNORE LEADING SPACES.
;PRINT CHARACTERS - ADJUST SPACE SIZES.
L1: LAC TXTPTR
CAMN ENDPTR↔GO EOL ;TEST FOR END OF PARAGRAPH.
CAMN LNPTR↔GO EOL ;TEST FOR ABNORMAL END OF LINE.
CALL(GETCHR)↔LAC TXTPTR
CAMN SPAPTR↔GO EOL ;TEST FOR NORMAL END OF LINE.
CAIN 1,12↔GO L1 ;IGNORE LINEFEEDS.
CAIN 1,00↔GO L1 ;IGNORE NULLS.
CAIN 1,11↔LACI 1,40 ;CONVERT TAB INTO A SPACE.
CAIN 1,15↔LACI 1,40 ;CONVERT CR INTO A SPACE.
CAIE 1,40↔DOM SPAFLG#
CAIE 1,40↔DZM DOUBLE# ;NOT SPACE - RESET.
CAIE 1,"."↔CAIN 1,"?"↔DOM DOUBLE# ;PERIOD OR QUESTION MARK.
DAC 1,CHAR
;EXECUTE A FONT CHANGE.
;PRINT THE CHARACTER.
CAIN 1,40↔GO L2
CALL(PRINT)↔GO L1
;COMPUTE A VARIABLE SPACE SIZE.
L2: AOSE SPAFLG↔GO L1 ;IGNORE MULTIPLE SPACES.
ZAC↔SKIPN SPACNT↔GO L3 ;TEST FOR NO VARIABLE SPACES.
LAC 0,EXTRA↔IDIV 0,SPACNT
SOS SPACNT
LAC 1,EXTRA↔SUB 1,0↔DAC 1,EXTRA
;PRINT A VARIABLE SPACE.
L3: LAC 1,FONT
SKIPN 1,FONTAB(1)↔HALT
CAR 1,40(1) ;WIDTH OF NORMAL SPACE.
SKIPE DOUBLE↔ASH 1,1 ;DOUBLE WIDTH SPACE.
ADD 1,0↔ADDM 1,COL ;ADVANCE COL VARIABLE SPACE.
GO L1
;EXECUTE A CARRIAGE RETURN LINE FEED.
EOL: LAC COLMIN↔DAC COL ;CARRIAGE RETURN.
JCALL LFEED
DECLARE{EXTRA}
ENDR LNJUST;9/20/73(BGB)---------------------------------------------
SUBR(TJLINE) ;CENTER OR RIGHT JUSTIFY A LINE OF TEXT.
;--------------------------------------------------------------------
;SKIP OVER LEADING BLANKS.
DZM TOTAL
PUSH P,TXTPTR↔PUSH P,CHRCNT ;SAVE SCANNER POSITION.
CALL(GETCHR)↔CAIE 1,40↔GO L1+1
POP P,0↔POP P,0↔GO TJLINE ;FLUSH THE STACK.
;FETCH A CHARACTER AND DO CONVERSIONS.
L1: CALL(GETCHR)
CAIN 1,00↔GO L1 ;IGNORE NULLS.
CAIN 1,11↔LACI 1,40 ;CONVERT TABS TO BLANKS.
;LINE TERMINATION ON CR OR ESCAPE
CAIN 1,15↔GO L2
CAMN 1,ESC↔GO L2
;ACCUMULATE CHARACTER WIDTH INTO TOTAL.
LAC 2,FONT↔LAC 2,FONTAB(2) ;FONT BASE ADDRESS.
ADD 2,1↔CAR 0,(2) ;WIDTH OF CHARACTER.
ADDM 0,TOTAL↔GO L1
;SET COLUMN FOR CENTER OR RIGHT JUSTIFICATION.
L2: LAC COLMAX↔SUB COLMIN↔SUB TOTAL ;EXTRA SPACE IN XGP UNITS.
LACM↔SKIPGE TJFLAG↔ASH -1 ;HALVE WHEN CENTERING.
ADD COLMIN↔DAC COL
DZM TJFLAG
;RESTORE THE SCANNER AND EXIT.
POP P,CHRCNT↔POP P,TXTPTR
POP0J
DECLARE{TOTAL}
ENDR TJLINE;9/23/73(BGB)---------------------------------------------
SUBR(DEFONT) DEFINE FONT NUMERAL N; TAKES N FROM AC-1.
;--------------------------------------------------------------------
DZM FILNAM ;ENTRY - SCAN FOR FILENAME.
INIT 1,17↔SIXBIT/DSK/↔0 ;ENTRY+1 - DON'T SCAN FILENAME.
GO[FATAL(CAN'T INIT DSK)]↔DAC 1,FONTCH
SKIPE FILNAM↔GO L1
CALL(GETCHR)↔ANDI 1,17↔DAC 1,FONT ;FONT NUMERAL.
CALL(GETFIL)↔GO L3 ;FONT FILE NAME.
;FIND FONT FILE.
L1: LOOKUP 1,FILNAM↔GO[
LACI'FNT'↔SKIPN EXTION↔DIPZ EXTION
LOOKUP 1,FILNAM↔GO[
LAC FNTPPN↔SKIPN PPPN↔DAC PPPN
LOOKUP 1,FILNAM↔GO[
OUTSTR[ASCIZ/ FONT NOT FOUND.
/]↔ GO L3]↔GO .+1]↔GO .+1]
L2: LAC 1,FONT ;FONT NUMBER.
LAC MAXADR↔DAC FONTAB(1) ;FONT BASE ADDRESS.
HLL PPPN↔SOS↔DAC INARG ;IOWD DUMP ARGUMENT.
MOVS PPPN↔MOVMS↔ADD MAXADR↔AOS ;TOP OF THE FONT.
DAC MAXADR↔CORE2↔HALT ;EXPAND UPPER SEGMENT.
IN 1,INARG
CALL(SETFNT)
L3: RELEASE 1,
POP0J
↑FONTCH: 0
MAXADR: %+4000 ;MAXIMUM ADDRESS SO FAR.
INARG:0↔0
ENDR DEFONT;2/7/73(TVR)2/25/73(BGB)----------------------------------
SUBR(SETFNT) SETUP A FONT, IMPLICIT ARGUMENT FONT.
;--------------------------------------------------------------------
LAC 1,FONT↔CDR 2,FONTAB(1) ;GET FONT BASE ADDRESS.
SKIPN 2↔POP0J ;EXIT WHEN FONT MISSING.
LACI =40↔DAC DROW ;LINE FEED DEFAULT.
SKIPE 1,201(2)↔DAC 1,DROW ;LINE FEED SPECIFIED.
LAC XLINE↔ADDM DROW ;INTER LINE SPACING.
LACI =25↔DAC DCOL ;SPACE DEFAULT.
SKIPE 1,202(2)↔DAC 1,DCOL ;SPACE SPECIFIED.
POP0J
ENDR SETFNT;2/7/72(TVR)-------------------------------------------
XFONT: CALL(GETCHR)↔DZM CMODE
CAIN 1,"."↔GO XFONT2 ;NO CHANGE.
CAIGE 1,"0"↔GO XFONT2
CAIG 1,"9"↔ANDI 1,17
CAIL 1,"A"↔GO[ANDI 1,37↔ADDI 1,=9↔GO .+1]
DAC 1,FONT↔SKIPE FONTAB(1)↔GO XFONT2 ;IS IT LOADED YET.
LAC FNTNAM(1)↔DAC FILNAM
LAC[SIXBIT/FNT/]↔DAC EXTION
LAC FNTPPN↔DAC PPPN
CALL(<DEFONT+1>)
XFONT2: SKIPE TJFLAG↔CALL(TJLINE) ;CENTER & RIGHT JUSTIFY.
POP0J
;--------------------------------------------------------------------
;FONT SELECT DELIMITERS.
FSD:BLOCK 7
;FIVE PAIRS: {} () [] ⊂⊃ ≤≥
;DECLARE FONT SELECT DELIMITER - COMMANDS {N; (N; [N; ⊂N; ≤N;
DFS: GO .+6↔GO .+5↔GO .+4
GO .+3↔GO .+2↔GO .+1
SUBI DFS↔ADDI FSD
CALL(GETCHR)
CAIGE 1,"0"↔POP0J
CAIG 1,"9"↔ANDI 1,17
CAIL 1,"A"↔GO[ANDI 1,37↔ADDI 1,=9↔GO .+1]
DIP 1,@↔SKIPE FONTAB(1)↔POP0J ;IS IT LOADED YET.
PUSH P,FONT↔DAC 1,FONT
LAC FNTNAM(1)↔DAC FILNAM
LAC[SIXBIT/FNT/]↔DAC EXTION
LAC FNTPPN↔DAC PPPN
CALL(<DEFONT+1>)↔POP P,FONT
POP0J
;LEFT FONT SELECT DELIMITER - TEXT MODE SELECT FONT.
LFS: GO .+6↔GO .+5↔GO .+4
GO .+3↔GO .+2↔GO .+1
SUBI LFS↔ADDI FSD
CAR 1,@↔SKIPN 1↔GO[AOS(P)↔POP0J]
EXCH 1,FONT↔DAP 1,@ ;SAVE RETURN FONT NUMBER.
CALL(SETFNT)
POP0J
;RIGHT FONT SELECT DELIMITER - TEXT MODE RESTORE FONT.
RFS: GO .+6↔GO .+5↔GO .+4
GO .+3↔GO .+2↔GO .+1
SUBI RFS↔ADDI FSD
CDR 1,@↔SKIPN 1↔GO[AOS(P)↔POP0J]
DAC 1,FONT
CALL(SETFNT)
POP0J
SUBR(MKSEG0) MAKE LINE SEGMENT. CLIPPER.
;--------------------------------------------------------------------
ACCUMULATORS{R1,C1,R2,C2,Q,N}
;TEST FOR EASY OUTSIDER.
LAC Q,C1↔LAC N,C2↔CAMLE C1,C2↔EXCH Q,N
CAIG Q,=1727↔SKIPGE N↔POP0J
LAC Q,R1↔LAC N,R2↔CAMLE R1,R2↔EXCH Q,N
CAMG Q,QHI↔CAMGE N,QLO↔POP0J
;TEST FOR EASY INSIDER.
JUMPL C1,L1↔JUMPL C2,L1
CAILE C1,=1727↔GO L1↔CAILE C2,=1727↔GO L1
CAMLE R1,QHI↔GO L1↔CAMLE R2,QHI↔GO L1
CAMGE R1,QLO↔GO L1↔CAMGE R2,QLO↔GO L1↔GO MKSEG1 ;DISPLAY.
;TEST FOR AND HANDLE SIMPLE CASES.
L1: CAMN R1,R2↔GO[
CAMN C1,C2↔POP0J↔GO HSEG]
CAMN C1,C2↔GO VSEG
;MIDPOINT THE HARD CASE.
PUSH P,R1↔PUSH P,C1 ;SAVE 1ST END.
ADD R1,R2↔ASH R1,-1 ;MIDPOINT THE LINE SEGMENT.
ADD C1,C2↔ASH C1,-1
;TEST FOR MIDPOINT AND 1ST END BEING COINCIDANT.
CAMN R1,-1(P)↔GO[
CAME C1, 0(P)↔GO .+1↔POP P,C1↔POP P,R1↔POP0J]
;RECURSION - DISPLAY ONE HALF AND THEN DISPLAY THE OTHER.
CALL(MKSEG0) ;MIDPOINT TO 2ND END.
LAC R2,-1(P)↔LAC C2,0(P)
CALL(MKSEG0) ;MIDPOINT TO 1ST END.
POP P,C1↔POP P,R1↔POP0J
;DISPLAY HORIZONTAL LINE SEGMENT FROM (C1 MIN C2) TO (C1 MAX C2).
HSEG: LAC Q,C1↔LAC N,C2↔CAML C1,C2↔EXCH N,Q
SKIPGE Q↔SETZ Q,↔CAILE N,=1727↔LACI N,=1727↔SUB N,Q
DOT(R1,Q)↔SKIPA↔IDPB 0,1↔SOJG N,.-1↔POP0J
;DISPLAY VERTICAL LINE SEGMENT FROM (R1 MIN R2) TO (R1 MAX R2).
VSEG: LAC Q,R1↔LAC N,R2↔CAML R1,R2↔EXCH N,Q
CAMGE Q,QLO↔LAC Q,QLO↔CAMLE N,QHI↔LAC N,QHI↔SUB N,Q
DOT(Q,C1)↔ADDI 1,WWIDTH
SOJG N,.-2↔POP0J
ENDR MKSEG0;4/24/73(BGB)---------------------------------------------
SUBR(MKSEG1) MAKE LINE SEGMENT.
;--------------------------------------------------------------------
COMMENT / Recursive midpoint method of quantizing a line segment.
Arguments are expected in accumulators R1, C1, R2, C2; the bit
is deposited from accumulator 0./
ACCUMULATORS{R1,C1,R2,C2,Q,N}
;TEST FOR AND HANDLE SIMPLE CASES.
LAC 1,R1↔SUB 1,R2↔MOVMS 1↔CAIGE 1,2↔GO[
CAMN C1,C2↔GO[DOT(R1,C1)↔POP0J]↔GO HSEG]
LAC 1,C1↔SUB 1,C2↔MOVMS 1↔CAIGE 1,2↔GO VSEG
;MIDPOINT THE HARD CASE.
PUSH P,R1↔PUSH P,C1 ;SAVE 1ST END.
ADD R1,R2↔ASH R1,-1 ;MIDPOINT THE LINE SEGMENT.
ADD C1,C2↔ASH C1,-1
;TEST FOR MIDPOINT AND 1ST END BEING COINCIDANT.
CAMN R1,-1(P)↔GO[
CAME C1, 0(P)↔GO .+1↔POP P,C1↔POP P,R1
DOT(R1,C1)↔DOT(R2,C2)↔POP0J]
;RECURSION - DISPLAY ONE HALF AND THEN DISPLAY THE OTHER.
CALL(MKSEG1) ;MIDPOINT TO 2ND END.
LAC R2,-1(P)↔LAC C2,0(P)
CALL(MKSEG1) ;MIDPOINT TO 1ST END.
POP P,C1↔POP P,R1↔POP0J
;DISPLAY HORIZONTAL LINE SEGMENT FROM (C1 MIN C2) TO (C1 MAX C2).
HSEG: LAC Q,C1↔LAC N,C2
CAML C1,C2↔EXCH N,Q↔SUB N,Q
DOT(R1,Q)↔SKIPA↔IDPB 0,1
SOJG N,.-1↔POP0J
;DISPLAY VERTICAL LINE SEGMENT FROM (R1 MIN R2) TO (R1 MAX R2).
VSEG: LAC Q,R1↔LAC N,R2
CAML R1,R2↔EXCH N,Q↔SUB N,Q
DOT(Q,C1)↔ADDI 1,WWIDTH
SOJG N,.-2↔POP0J
ENDR MKSEG1;4/24/73(BGB)---------------------------------------------
SUBR(IIISIM) OUTPUT III BUFFER ONTO XGP.
;--------------------------------------------------------------------
ACCUMULATORS{X,Y,R,C,IIIWRD}
;DELTA ORIGIN DISPLACEMENT.
SLACI 1,(2B2)↔LAC CHAR
CAIN"*"↔SETZ 1,↔DAC 1,DELTA
;III FILE NAME.
CALL(GETFIL)↔POP0J
INIT 17,17↔SIXBIT/DSK/↔0
GO[FATAL(CAN'T INIT DSK)]
LOOKUP 17,FILNAM↔GO[LAC[SIXBIT/PLT/]↔DAC EXTION
LOOKUP 17,FILNAM↔GO[LAC[SIXBIT/III/]↔DAC EXTION
LOOKUP 17,FILNAM↔GO[LAC[SIXBIT/DAT/]↔DAC EXTION
LOOKUP 17,FILNAM↔GO[LAC[SIXBIT/TMP/]↔DAC EXTION
LOOKUP 17,FILNAM↔GO[FATAL<III OR VIDEO FILE NOT FOUND.>]
GO L0]↔GO L0]↔GO L0]↔GO L0]
;EXPAND CORE FOR DUMP INPUT.
L0: LAC JOBREL↔DAC OLD44#
NIP 1,PPPN↔MOVN 1,1
ADD 1,JOBREL↔DAC 1,BUFEND#
CORE 1,↔GO[FATAL(CAN'T EXPAND CORE)]
;SAVE CURRENT XGP BEAM POSITION.
LAC FONT↔DAC BEGFNT#
LAC COL↔DAC BEGCOL#
LAC ROW↔DAC BEGROW#
LACI 2↔DAC IIISIZ ;INITIAL III CHARACTER SIZE.
;DUMP III FILE IN.
LAC OLD44↔ADDM PPPN↔IN 17,PPPN
LAC 1,OLD44↔LAC(1)↔CAMN[-1]↔GO VIDEO ;TEST 1ST WORD = -1.
LAC 1,OLD44↔ADDI 1,2↔DAC 1,PC# ;III PC.
L1: CDR 1,BUFEND↔DZM -1(1)↔DZM(1)
CAML 1,JOBREL↔GO .+3
LIPI 1,-1(1)↔BLT 1,JOBREL ;CLEAR TOP.
;FETCH AND DECODE III COMMAND WORD.
ILOOP: AOSA 1,PC
LOOP: LAC 1,PC↔CAMLE 1,JOBFF
CAML 1,BUFEND↔GO RET
LAC IIIWRD,(1)
TRNE IIIWRD,01↔GO XTEXT ;TEXT COMMAND WORD.
TRNE IIIWRD,02↔GO XVECTR ;VECTOR COMMAND WORD.
TRNE IIIWRD,20↔GO XCTRL ;III CONTROL WORD.
TRNE IIIWRD,37↔GO ILOOP ;NOP & HALT COMMANDS.
RET: LAC OLD44↔CORE↔GO[FATAL(CAN'T SHRINK CORE!)]
FRET: RELEASE 17,
LAC BEGFNT↔DAC FONT
LAC BEGCOL↔DAC COL
LAC BEGROW↔DAC ROW
POP0J
;EXECUTE III TEXT.
XTEXT: PUSH P,IIIWRD ;-2(P)
PUSH P,[5] ;-1(P)
PUSH P,[POINT 7,-2(P)] ; 0(P)
CLOOP: ILDB 1,0(P)↔JUMPE 1,CCONT↔DAC 1,CHAR
CAIN 1,15↔GO[
LAC 1,IIISIZ↔LAC 1,CHRWID(1)↔ROT 1,-12
MOVNS 1↔ADDM 1,YBEAM
LAC 1,[-511]↔DAC 1,XBEAM↔GO CCONT]
PUSH P,ROW↔PUSH P,COL ;SAVE XGP-BEAM POSITION.
;COMPUTE XGP ROW AND COLUMN.
LACN R,YBEAM↔ADD R,DELTA↔MUL R,IIIDY↔ADD R,BEGROW↔DAC R,ROW
LAC C,XBEAM↔ADD C,DELTA↔MUL C,IIIDX↔ADD C,BEGCOL↔DAC C,COL
LAC 1,IIISIZ↔LAC 1,CHRWID(1)↔ROT 1,-13↔ADDM 1,XBEAM
;COMPUTE FONT SIZE.
LAC 1,IIISIZ↔LAC CHRWID(1)↔FLOAT↔FMP SCALEX↔FIXX↔LACI 1,1
CAIL 0,=7↔AOS 1
CAIL 0,=20↔AOS 1↔CAIL 0,=25↔AOS 1
CAIL 0,=30↔AOS 1↔CAIL 0,=40↔AOS 1
CAIN 1,1↔GO[LAC 1,CHAR↔SETO↔CAIN 1,40↔GO CCONT2
LAC R,ROW↔LAC C,COL
CAMG R,QHI↔CAMGE R,QLO↔GO CCONT2
DOT(R,C)↔GO CCONT2]
CAMN 1,FONT↔GO CCONT3↔DAC 1,FONT
SKIPE FONTAB(1)↔GO CCONT4
DAC 1,FONT↔LAC FNTNAM(1)↔DAC FILNAM
LAC[SIXBIT/FNT/]↔DAC EXTION
LAC FNTPPN↔DAC PPPN
CALL(<DEFONT+1>)
CCONT4: LAC 1,FONT↔CALL(SETFNT)
CCONT3: LAC 1,CHAR↔CALL(PRINT)
CCONT2: POP P,COL↔POP P,ROW ;RESTORE XGP-BEAM POSITION.
CCONT: SOSLE -1(P)↔GO CLOOP
SUB P,[XWD 3,3]
GO ILOOP
;EXECUTE III CONTROL OPERATIONS.
XCTRL: TRNN IIIWRD,04↔GO[CAR 1,IIIWRD↔DAC 1,PC↔GO LOOP] ;JUMP.
TRNE IIIWRD,40↔GO LOOP ;SAVE A NOP HERE
AOS 1,PC ;JSR
HRLI 1,20
CAR 2,IIIWRD
CAMLE 2,JOBFF
CAML 2,BUFEND↔GO[ OUTSTR[ASCIZ/JSR OUT OF BOUNDS
/]↔ GO RET]
DAC 1,(2)↔DAC 2,PC
GO ILOOP
;EXECUTE VECTORS.
XVECTR: TRNN IIIWRD,4
GO [TRNN IIIWRD,10 ;SHORT VECTOR OR TSS
GO SVECT ;SHORT VECTOR
GO ILOOP] ;TSS
LDB [POINT 11,IIIWRD,10]↔ROT -13↔DAC X ;X FIELD.
LDB [POINT 11,IIIWRD,21]↔ROT -13↔DAC Y ;Y FIELD
LDB [POINT 3,IIIWRD,24]↔SKIPE↔DAC IIIBRT ;BRIGHTNESS
LDB [POINT 3,IIIWRD,27]↔SKIPE↔DAC IIISIZ ;CHR SIZE
LDB 1,[POINT 3,IIIWRD,31]↔CALL(VECTOR) ;OP CODE.
GO ILOOP
SVECT: PUSH P,IIIWRD ;SAVE III COMMAND.
LDB [POINT 7,IIIWRD,06]↔ROT -7↔ASH -4↔DAC X ;X FIELD.
LDB [POINT 7,IIIWRD,13]↔ROT -7↔ASH -4↔DAC Y ;Y FIELD.
LDB 1,[POINT 2,IIIWRD,15]↔CALL(VECTOR) ;OP CODE.
POP P,IIIWRD ;RESTORE III COMMAND.
LDB [POINT 7,IIIWRD,22]↔ROT -7↔ASH -4↔DAC X ;X FIELD.
LDB [POINT 7,IIIWRD,29]↔ROT -7↔ASH -4↔DAC Y ;Y FIELD.
LDB 1,[POINT 2,IIIWRD,31]↔CALL(VECTOR) ;OP CODE.
GO ILOOP
VECTOR: SETO↔TRNE 1,2↔SETZ ;SKIP ON VISIBLE VECTOR.
TRNE 1,4↔GO .+3 ;SKIP ON RELATIVE VECTOR.
ADD X,XBEAM↔ADD Y,YBEAM
DAC X,XBEAM↔DAC Y,YBEAM
LACN R,Y↔ADD R,DELTA↔MUL R,IIIDY↔ADD R,BEGROW ;Y INTO ROW.
LAC C,X↔ADD C,DELTA↔MUL C,IIIDX↔ADD C,BEGCOL ;X INTO COL.
TRNE 1,1↔GO VPOINT ;SKIP NOT POINT VECTOR.
LAC 2,ROW↔LAC 3,COL ;FROM OLD XGP BEAM POSITION.
DAC R,ROW↔DAC C,COL ;SAVE NEW XGP BEAM POSITION.
SKIPE↔CALL(MKSEG0)↔POP0J ;PLOT VECTOR - POP STACK.
;PLOT A DOT 3 BY 3.
VPOINT: SOS R↔DAC R,ROW↔SOS C↔DAC C,COL ;SAVE NEW XGP BEAM POSITION.
CAML R,QLO↔CAMLE R,QHI↔POP0J
SETO↔DOT(R,C)↔AOS C↔DOT(R,C)
LAC R,ROW↔LAC C,COL↔ADDI R,1
CAML R,QLO↔CAMLE R,QHI↔POP0J
SETO↔DOT(R,C)↔AOS C↔DOT(R,C)↔AOS C↔DOT(R,C)
LAC R,ROW↔LAC C,COL↔ADDI R,2
CAML R,QLO↔CAMLE R,QHI↔POP0J
SETO↔DOT(R,C)↔AOS C↔DOT(R,C)↔AOS C↔DOT(R,C)↔POP0J
DECLARE{XBEAM,YBEAM,IIIBRT,IIISIZ}
CHRWID: 0↔8↔12↔14↔16↔24↔32↔48 ;III CHARACTER WIDTHS.
ENDR IIISIM;2/8/73(TVR)8/21/73(BGB)----------------------------------
DELTA: 0
SUBR(VIDEO)
;--------------------------------------------------------------------
COMMENT⊗ VIDEO FILE HEADER
0 -1
1 6 BITS PER BYTE.
2 =48 WORDS PER ROW.
3 R1
4 R2
5 C1
6 C2
7 -WC,,ADR ⊗
ACCUMULATORS{S2,S3,I,J,K,Q,P1,P2,R,C,TV}
;EXPECT AC-1 TO CONTAIN POINTER TO WORD ZERO OF VIDEO FILE IN CORE.
LAC TV,1↔LAC 2(TV)↔DAC TVWIDTH#
LAC 4(TV)↔SUB 3(TV)↔AOS↔DAC TVROWS#↔DZM TVROW0#
LAC 6(TV)↔SUB 5(TV)↔AOS↔DAC TVCOLS#
LAC R,ROW↔SKIPN DELTA↔GO[LAC TVROWS↔ASH 1↔SUB R,0↔GO .+1]
TRZ R,3 ;UPPER LEFT MOST CORNER OF IMAGE.
CAMLE R,QHI↔POP0J ;WHOLE VIDEO IMAGE BELOW THIS QPAGE.
CAML R,QLO↔GO L0 ;VIDEO IMAGE STARTS ON THIS QPAGE.
;VIDEO IMAGE STARTS BEFORE THIS QUARTER PAGE.
L00: SUB R,QLO↔ASH R,-2
MOVM R,R↔DAC R,TVROW0#
CAML R,TVROWS↔POP0J ;WHOLE VIDEO IMAGE ABOVE THIS QPAGE.
SUB R,TVROWS
DACM R,TVROWS↔LAC R,QLO
;VIDEO BYTE POINTER.
L0: LAC P1,1(TV) ;BYTE SIZE.
IORI P1,4400↔ROT P1,-=12
LAP P1,7(TV)↔ADD P1,1 ;ORIGIN OF VIDEO IN CORE.
LAC TVROW0↔IMUL TVWIDTH↔ADD P1,0
;POINTER INTO XGP BUFFER.
LAC C,COL↔SKIPN DELTA↔GO[LAC TVCOLS↔ASH 1↔SUB C,0↔GO .+1]
HLLZ 1,%(C)↔ROT 1,6
HRRI 1,@%(R)↔CDR P2,1
;J = COLUMNS/9 9 4-BIT XGP BYTES PER WORD.
LACI J,=36↔IDIV J,1(TV)
IMUL J,2(TV)↔IDIVI J,=9↔DAC J,JSAV# ;COLUMNS/9
LAC I,TVROWS
L1: DAC P2,P2SAV#↔LAC J,JSAV
L2: SETZB 0,1↔SETZB 2,3↔LACI K,=9
L3: ILDB Q,P1
TRZ Q,3↔ROTC 0,4↔ROTC 2,4
IOR 0,HTT+0(Q)↔IOR 1,HTT+1(Q)
IOR 2,HTT+2(Q)↔IOR 3,HTT+3(Q)↔SOJG K,L3
CAIL C,=1728↔GO L4
IORM 0,0*WWIDTH(P2)↔IORM 1,1*WWIDTH(P2)
IORM 2,2*WWIDTH(P2)↔IORM 3,3*WWIDTH(P2)
L4: AOS P2↔SOJG J,L2
ADDI R,4↔CAMLE R,QHI↔POP0J
LAC P2,P2SAV↔ADDI P2,4*WWIDTH
SOJG I,L1
POP0J
;HALF TONE TABLE.
HTT: 6↔7↔7↔6↔ 6↔6↔7↔6↔ 6↔6↔6↔6↔ 6↔6↔6↔6
6↔6↔6↔4↔ 4↔6↔6↔4↔ 4↔6↔6↔4↔ 4↔4↔6↔4
4↔4↔4↔4↔ 4↔4↔4↔4↔ 0↔4↔4↔4↔ 4↔4↔4↔0
0↔4↔4↔0↔ 0↔0↔4↔0↔ 0↔0↔4↔0↔ 0↔0↔0↔0
ENDR VIDEO;6/2/73(BGB)-----------------------------------------------
SUBR(GETFIL) ;GET FILE SPECIFICATION - SKIP OK.
;--------------------------------------------------------------------
;CLEAR FILENAME SPECIFICATION.
DZM FILNAM
DZM EXTION
DZM EXTION+1
DZM PPPN
;AC1-CHR, AC2-CNT, AC3, AC4-BP.
LAC 4,[POINT 6,FILNAM,-1]↔LACI 2,6
L: CALL(GETCHR)
CAIN 1,15↔GO[CALL(GETCHR)↔GO EOL]
CAILE 1,"z"↔POP0J
CAIL 1,"a"↔SUBI 1,40 ;CONVERT LOWER CASE
CAIN 1,"."↔GO[LAC 4,[POINT 6,EXTION,-1]↔LACI 2,3↔GO L]
CAIN 1,"["↔GO[LAC 4,[POINT 6,PPPN,-1] ↔LACI 2,3↔GO L]
CAIN 1,","↔GO[LAC 4,[POINT 6,PPPN,17] ↔LACI 2,3↔GO L]
CAIN 1,"]"↔CALL(GETCHR)
CAIN 1,";"↔GO EOL ;XAP COMMAND POSTFIX.
CAIG 1," "↔GO EOL
SOJL 2,L↔SUBI 1,40 ;COUNT'EM AND CONVERT TO SIXBIT.
IDPB 1,4↔GO L ;PACK CHARACTER INTO SPECIFICATIONS.
EOL:
CAR PPPN↔TRNN 77↔LSH -6↔TRNN 77↔LSH -6↔DIP PPPN
CDR PPPN↔TRNN 77↔LSH -6↔TRNN 77↔LSH -6↔DAP PPPN
AOS(P)↔POP0J
ENDR GETFIL;5/30/73(BGB)---------------------------------------------
SUBR(GETCHR) GET A CHARACTER FROM THE TEXT BUFFER.
SOSGE CHRCNT↔GO .+3
ILDB 1,TXTPTR↔POP0J
SETOM EOF↔SETZ 1,
POP0J
ENDR GETCHR;5/30/73(BGB)---------------------------------------------
SUBR(GETNUM) GET AN INTEGER.
SETZM↔CALL(GETCHR)
CAIL 1,"0"↔CAILE 1,"9"↔GO[
EXCH 1,0↔POP0J]↔ANDI 1,17
IMULI 0,=10↔ADD 0,1
GO GETNUM+1
ENDR GETNUM;---------------------------------------------------------
SUBR(GET14) GET A 14 BIT NUMBER
CALL(GETCHR)↔LSH 1,7↔PUSH P,1
CALL(GETCHR)↔ADD 1,(P)↔POP P,(P)
POP0J
ENDR GET14;----------------------------------------------------------
SUBR UNGETCHR
AOS CHRCNT
SETZM EOF
MOVSI 070000
ADDM TXTPTR
POP0J
ENDR UNGETCHR;17-MAR-74(TVR)
SUBR(INFILE) INDIRECT FILE COMMAND "@".
;--------------------------------------------------------------------
;FILE INITIALIZATION.
PUSH P,TXTPTR ;SAVE TEXT POINTER.
INIT 1,17↔SIXBIT/DSK/↔0
GO[FATAL(CAN'T INIT DSK)]
CALL(GETFIL)↔POP0J
LOOKUP 1,FILNAM↔GO L1
;WIPE OUT INDIRECT COMMAND.
POP P,1↔ADD 1,[7B5] ;DECREMENT OLDE TEXT POINTER.
LACI"F"↔IDPB 0,1
LACI"."↔IDPB 0,1
DAPZ 1,PTR1#
SETZ↔IDPB 0,1
CAME 1,TXTPTR↔GO .-2
DAPZ 1,PTR2#
;EXPAND CORE WHEN NECESSARY.
NIP PPPN↔MOVMS↔DAC SIZE# ;WORD COUNT.
IMULI =5↔ADDM CHRCNT↔ADDM SAVCNT ;NEW CHARACTER COUNT.
LAC 1,TXTEND↔ADD 1,SIZE↔DAC 1,NEWEND# ;NEW TOP OF CORE.
CDR 1,NEWEND↔CAMG 1,JOBREL↔GO .+3
CORE 1,↔GO[FATAL(<NO ROOM FOR TEXT.>)]
;MOVE TOP OF TEXT BUFFER UP CORE.
SETO 1,↔LAP 1,TXTEND
LAC SIZE↔DAP .+3
CDR TXTEND↔SUB PTR2
POP 1,SIZE(1)↔SOJG .-1
;STEP ON A FUNNY CASE.
LAC 1,PTR1↔LAC 2,PTR2↔CAME 1,2↔GO L2
ADD 2,SIZE↔LIPI 1,440700↔LIPI 2,440700
SETZ 3,↔LACI 4,5
ILDB 0,1↔IDPB 3,2 ;CLEAR LEADING BYTES OF TWO.
SOJLE 4,L2↔JUMPN 0,.-3
IDPB 3,2↔SOJG 4,.-1 ;CLEAR LAGGING BYTES OF ONE.
L2:
;INPUT THE FILE.
LAC NEWEND↔DAC TXTEND
; LAC PPPN↔LAP PTR1↔DAC DUMARG
LAC PTR1↔LIPI 000700↔DAC TXTPTR↔HLL PPPN↔DAC DUMARG
IN 1,DUMARG↔GO[ RELEASE 1,
SETZM CMODE ;ENTER TEXT MODE.
POP0J ]
FATAL(READ ERROR!)
DUMARG:0↔0
L1: OUTSTR[ASCIZ/FILE NOT FOUND - /]
POP P,1↔LAC 2,[POINT 7,4]↔LACI 3,=25
ILDB 1↔CAIN";"↔GO .+3↔IDPB 2↔SOJG 3,.-4
SETZ↔IDPB 2↔OUTSTR 4↔CRLF↔EXIT
ENDR INFILE;5/30/73(BGB)---------------------------------------------
;COMMAND EXECUTION.
;--------------------------------------------------------------------
;ABSOLUTE INVISIBLE VECTOR.
AI: CALL(GETNUM)↔DAC 1,ROW
CALL(GETNUM)↔DAC 1,COL↔POP0J
;--------------------------------------------------------------------
;ABSOLUTE VISIBLE VECTOR.
AV: CALL(GETNUM)↔DAC 1,4
CALL(GETNUM)↔DAC 1,5
AV1: SKIPE ARROW1↔GO[CALL(MKARROW,4,5)↔POP P,5↔POP P,4↔GO .+1]
LAC 2,ROW↔LAC 3,COL
DAC 4,ROW↔DAC 5,COL
SKIPE ARROW2↔GO[CALL(MKARROW,2,3)↔POP P,3↔POP P,2↔GO .+1]
LAC 4,ROW↔LAC 5,COL
SETO↔CALL(MKSEG0)↔POP0J
;--------------------------------------------------------------------
;Loren Rush's ABSOLUTE VISIBLE VECTOR. (Like a locus statement!)
MUZAV: CALL(REALIN)↔FADR[864.0]↔FIXX↔DAC 5
CALL(REALIN)↔FSBR[1024.0]↔FIXX↔DACN 4
CALL(UNGETCHR) ;Keep that break character!
JRST AV1
;--------------------------------------------------------------------
XMARGN: CALL(GETNUM)↔DAC 1,LMAR
POP0J
XRADIAL:
CALL(GETNUM)↔DAC 1,5↔FLOAT 5,↔DAC 5,4
CALL(GETNUM)↔DAC 1,3↔FLOAT 3,↔DAC 3,2
FMP 2,SINE↔MOVNS 2↔FIXX 2,↔ADD 2,ROW
FMP 4,SINE↔MOVNS 4↔FIXX 4,↔ADD 4,ROW
FMP 3,COSINE↔FIXX 3,↔ADD 3,COL
FMP 5,COSINE↔FIXX 5,↔ADD 5,COL
SETO↔CALL(MKSEG0)↔POP0J
;--------------------------------------------------------------------
SEMICO: DZM ARROW1↔DZM ARROW2↔POP0J
;--------------------------------------------------------------------
XARROW: CAIE 1,"↔"↔GO .+3
SETOM ARROW1↔SETOM ARROW2
CAIN 1,"←"↔SETOM ARROW1
CAIN 1,"→"↔SETOM ARROW2
POP0J
XARRLW: CALL(REALIN)↔DAC ARROWW
CALL(REALIN)↔DAC ARROWL
POP0J
SUBR(MKARROW)ROW2,COL2
LAC 0,ARG1↔SUB 0,COL↔FLOAT 0,↔DAC 0,10↔FMP 0,0
LAC 1,ARG2↔SUB 1,ROW↔FLOAT 1,↔DAC 1,11↔FMP 1,1
FAD 1,0↔CALL(SQRT,1)
PUSH P,SINE↔PUSH P,COSINE ;SAVE OLDE ORIENTATION.
LAC 10↔FDV 1↔DAC COSINE
LAC 11↔FDV 1↔DACN SINE
SETZB 2,3↔LAC 4,ARROWL↔LAC 5,ARROWW↔CALL(MKSEG3)
SETZB 2,3↔LAC 4,ARROWL↔LACN 5,ARROWW↔CALL(MKSEG3)
LAC 2,ARROWL↔LAC 3,ARROWW
LAC 4,ARROWL↔LACN 5,ARROWW↔CALL(MKSEG3)
POP P,COSINE↔POP P,SINE
POP0J
ENDR MKARROW;--------------------------------------------------------
ARROW1: 0 ;ARROW HEAD 1ST VERTEX - PREFIX FLAG.
ARROW2: 0 ;ARROW HEAD 2ND VERTEX - PREFIX FLAG.
ARROWW: 15.0 ;ARROW HALF WIDTH.
ARROWL: 45.0 ;ARROW LENGTH.
;III DISPLAY SCALE FACTOR.
XXSCAL: CALL(REALIN)↔DAC SCALEX
FMPR[1024.]↔FIXX↔DAC IIIDX
POP0J
YYSCAL: CALL(REALIN)↔DAC SCALEY
FMPR[1024.]↔FIXX↔DAC IIIDY
POP0J
XROTAT: CALL(READARC)↔DAC ROTDEL
SETQ(SINE,{SIN,ROTDEL})
SETQ(COSINE,{COS,ROTDEL})
POP0J
;--------------------------------------------------------------------
XLOCUS: ;L<X>,<Y>
CALL(REALIN)↔FADR[864.0]↔FIXX↔DAC COL
CALL(REALIN)↔FSBR[1024.0]↔FIXX↔DACN ROW
POP0J
SUBR(SQRT)
;MODIFIED OLDE LIB40 SQUARE ROOT - BGB - TRADITIONAL.
A←0 ↔ B←←1 ↔ C←2
MOVM B,ARG1↔JUMPE B,POP1J.↔PUSH P,2
;LET X=F*(2↑2B) WHERE 0.25<F<1.00 THEN SQRT(X)=SQRT(F)*(2↑B).
ASHC B,-=27↔SUBI B,201 ;GET EXPONENT IN B, FRACTION IN C.
ROT B,-1 ;CUT EXP IN HALF, SAVE ODD BIT
HRRM B,L↔LSH B,-=35 ;USE THAT ODD BIT.
ASH C,-10↔FSC C,177(B) ;0.25 < FRACTION < 1.00
;LINEAR APPROXIMATION TO SQRT(F).
MOVEM C,A
FMP C,[0.8125↔0.578125](B)
FAD C,[0.302734↔0.421875](B)
;TWO ITERATIONS OF NEWTON'S METHOD.
MOVE B,A
FDV B,C↔FAD C,B↔FSC C,-1
FDV A,C↔FADR A,C
L: FSC A,0↔MOVE 1,A↔POP P,2
POP1J
ENDR SQRT;--------------------------------------------------------
BEGIN SINCOS ;SINE & COSINE - BGB.
INTERN SIN,COS;---------------------------------------------------
A←←1 ↔ B←2 ↔ C←3
↑COS: SKIPA A,ARG1
↑SIN: SKIPA A,ARG1
FADR A,HALFPI ;COS(X) = SIN(X+π/2).
MOVM B,A↔CAMG B,[17B5]↔POP1J ;FOR SMALL X, SIN(X)=X.
;B ← (ABS(X)MODULO 2π)/HALFPI
;C ← QUADRANT 0, 1, 2 OR 3.
FDVR B,HALFPI
LAC C,B↔FIX C,233000
CAILE C,3↔GO[TRZ C,3↔FSC C,233
FSBR B,C↔GO .-3] ;MODULO 2π.
GO .+1(C)↔GO .+4↔JFCL↔GO[
FSBRI B,(2.0)↔MOVNS B↔GO .+2] ;SIN(X+π)=SIN(-X)
FSBRI B,(4.0) ;SIN(X+2π)=SIN(X)
SKIPGE A↔MOVNS B ;SIN(-X) = -SIN(X).
;FOR -1 ≤ B ≤ +1 REPRESENTING -π/2 ≤ X ≤ +π/2,
;COMPUTE SINE(X) APPROXIMATION BY TAYLOR SERIES.
DAC B,C↔FMPR B,B
LAC A,[164475536722]↔FMP A,B
FAD A,[606315546346]↔FMP A,B
FAD A,[175506321276]↔FMP A,B
FAD A,[577265210372]↔FMP A,B
FAD A,HALFPI↔FMPR A,C↔POP1J
HALFPI: 201622077325↔LIT ;PI/2
BEND;-------------------------------------------------------------
READARC: ;AND REALIN.
CALL(REALIN)↔JUMPL[CAMG[6.3]↔FMPR[0.0174533]↔POP0J]
CAML[6.3]↔FMPR[0.0174533]↔POP0J
SUBR(REALIN)
;--------------------------------------------------------------------
;<EXPR> ::= <EXPR>+<TERM>|<EXPR>-<TERM>|<TERM>
;<TERM> ::= <TERM>*<PRIMARY>|<TERM>/<PRIMARY>|<PRIMARY>
;<PRIMARY> ::= -<PRIMARY>|(<EXPR>)||π|<REAL NUMBER>
CALL(TERM)
CAIN 1,"+"↔GO[
PUSH P,0↔CALL(TERM)↔FADR 0,(P)
SUB P,[XWD 1,1]↔GO REALIN+1]
CAIN 1,"-"↔GO[
PUSH P,0↔CALL(TERM)↔MOVN 0,0↔FADR 0,(P)
SUB P,[XWD 1,1]↔GO REALIN+1]
POP0J↔POP0J
TERM: CALL(PRIMARY)
TERM2: CAIN 1,"*"↔GO[
PUSH P,0↔CALL(PRIMARY)↔FMPR 0,(P)
SUB P,[XWD 1,1]↔GO TERM2]
CAIN 1,"/"↔GO[
PUSH P,0↔CALL(PRIMARY)↔EXCH 0,(P)↔FDVR 0,(P)
SUB P,[XWD 1,1]↔GO TERM2]
POP0J
;BEGIN REALIN ; INPUT SMALL REAL NUMBER - BGB - 16 DEC 1972
;AC-0 INTEGER ACCUMULATION. AC-0 RETURNS REAL NUMBER.
;AC-1 CHARACTER. AC-1 RETURNS BREAK CHARACTER.
;AC-2 COUNTER OF DIGITS TO RIGHT OF DECIMAL POINT PLUS ONE.
;AC-3 MINUS SIGN FLAG.
PRIMARY:SETZ↔SETZB 2,3
L0: CALL(GETCHR)
CAIN 1," "↔GO .-2
CAIN 1,"-"↔GO[SETCMM 3↔GO L0]
CAIN 1,"π"↔GO[MOVE 0,[3.1415926]
GETRET: CALL(GETCHR)↔GO L3]
CAIN 1,"("↔GO[PUSH P,3↔CALL(REALIN)↔POP P,3
CAIN 1,")"↔GO GETRET
OUTSTR[ASCIZ/WARNING: MISSING ')'
/]↔ POP0J]
SKIPA
L1: CALL(GETCHR)
CAIN 1,";"↔GO L2↔CAIN 1,","↔GO L2
CAIE 1,"."↔GO .+3↔JUMPN 2,L2↔AOJA 2,L1
CAIL 1,"0"↔CAILE 1,"9"↔GO L2
JUMPN 2,[CAILE 2,4↔GO L1↔AOJA 2,.+1]
ANDI 1,17↔IMULI =10↔ADD 1↔GO L1
L2: FLOAT↔SOSLE 2↔FDVR[1.0↔10.0↔100.0↔1000.0↔10000.0](2)
L3: SKIPE 3↔MOVNS↔POP0J
ENDR REALIN;12/16/72(BGB),14-MAR-73(TVR)-----------------------------
SUBR(DPYDOT)X,Y ;DISPLAY A DOT.
;--------------------------------------------------------------------
;PLACE A DOT AT LOCUS (X,Y).
;DILATION, ROTATION, TRANSLATION, & CLIP.
ACCUMULATORS{R,C}
LAC R,ARG1↔LAC C,ARG2
FMP R,SCALEY↔LAC 0,R ;DILATION.
FMP C,SCALEX↔LAC 1,C
FMP 0,SINE↔FMP R,COSINE ;ROTATION.
FMP 1,SINE↔FMP C,COSINE
FADR R,1↔FSBR C,0↔MOVNS R
FIXX R,↔ADD R,ROW ;TRANSLATION.
FIXX C,↔ADD C,COL
CAMGE R,QLO↔POP2J ;CLIP.
CAMLE R,QHI↔POP2J
SKIPGE C↔POP2J
CAILE C,=1728
SETO↔DOT(R,C)↔POP2J ;DISPLAY.
ENDR DPYDOT;5/29/73(BGB)---------------------------------------------
SUBR(MKSEG3)
;--------------------------------------------------------------------
R←←2 ↔ C←←3
EXCH R,C
FMP R,SCALEY↔LAC 0,R ;DILATION.
FMP C,SCALEX↔LAC 1,C
FMP 0,SINE↔FMP R,COSINE ;ROTATION.
FMP 1,SINE↔FMP C,COSINE
FADR R,1↔FSBR C,0↔MOVNS R
FIXX R,↔ADD R,ROW ;TRANSLATION.
FIXX C,↔ADD C,COL
R←←4 ↔ C←←5
EXCH R,C
FMP R,SCALEY↔LAC 0,R ;DILATION.
FMP C,SCALEX↔LAC 1,C
FMP 0,SINE↔FMP R,COSINE ;ROTATION.
FMP 1,SINE↔FMP C,COSINE
FADR R,1↔FSBR C,0↔MOVNS R
FIXX R,↔ADD R,ROW ;TRANSLATION.
FIXX C,↔ADD C,COL
SETO↔GO MKSEG0
ENDR MKSEG3;_________________________________________________________
SUBR(XCONIC) ;E<A>,<B>,<X1>,<X2>;
;--------------------------------------------------------------------
SLACI(<1.0>)
CAIE 1,"H"↔MOVNS
DAC ONE↔DZM FLAG#
CALL(REALIN)↔DACM A#↔CAIN 1,";"↔GO[DOM FLAG↔DACM B↔DACN X1↔DACM X2↔GO L1]
CALL(REALIN)↔DACM B#↔CAIN 1,";"↔GO[DOM FLAG↔LAC A↔DACN X1↔DACM X2↔GO L1]
CALL(REALIN)↔DAC X1#
CALL(REALIN)↔DAC X2#
L1: LACI CONIC↔DAP FN ;FUNCTION ARGUMENT.
CALL(CONIC,X1)↔DAC 1,Y1#
CALL(CONIC,X2)↔DAC 1,Y2#
LAC 2,X1↔LAC 3,Y1
LAC 4,X2↔LAC 5,Y2
CALL(MKCURV)
SKIPN FLAG↔POP0J
MOVNS COSINE↔MOVNS SINE↔MOVNS FLAG ;PI ROTATION.
SKIPG FLAG↔POP0J↔GO L1
CONIC: LAC 1,ARG1↔FDV 1,A↔FMP 1,1
FADR 1,ONE↔CALL(SQRT,1)↔FMP 1,B↔POP1J
ONE: 1.0
ENDR XCONIC;---------------------------------------------------------
FN: GO ;FUN ARG PROBLEM.
SUBR(XBOX)
ACCUMULATORS{X1,Y1,X2,Y2}
CALL(REALIN) ↔ DACM PDX# ↔ DACN NDX# ↔ CAIE 1,";"
CALL(REALIN) ↔ DACM PDY# ↔ DACN NDY#
LAC X1,NDX↔LAC Y1,NDY↔LAC X2,NDX↔LAC Y2,PDY↔CALL(MKSEG3) ;WEST.
LAC X1,PDX↔LAC Y1,NDY↔LAC X2,PDX↔LAC Y2,PDY↔CALL(MKSEG3) ;EAST.
LAC X1,NDX↔LAC Y1,NDY↔LAC X2,PDX↔LAC Y2,NDY↔CALL(MKSEG3) ;SOUTH.
LAC X1,NDX↔LAC Y1,PDY↔LAC X2,PDX↔LAC Y2,PDY↔CALL(MKSEG3) ;NORTH.
POP0J
ENDR XBOX
SUBR(XDIAMON)
ACCUMULATORS{X1,Y1,X2,Y2}
CALL(REALIN) ↔ DACM PDX# ↔ DACN NDX# ↔ CAIE 1,";"
CALL(REALIN) ↔ DACM PDY# ↔ DACN NDY#
LAC X1,NDX↔LAC Y1,[0]↔LAC X2,[0]↔LAC Y2,PDY↔CALL(MKSEG3) ;NW
LAC X1,PDX↔LAC Y1,[0]↔LAC X2,[0]↔LAC Y2,PDY↔CALL(MKSEG3) ;NE
LAC X1,[0]↔LAC Y1,NDY↔LAC X2,PDX↔LAC Y2,[0]↔CALL(MKSEG3) ;SE
LAC X1,[0]↔LAC Y1,NDY↔LAC X2,NDX↔LAC Y2,[0]↔CALL(MKSEG3) ;SW
POP0J
ENDR XDIAMON
SUBR(XSWINE) ;MAKE BOX WITH ROUNDED CORNERS.
ACCUMULATORS{X1,Y1,X2,Y2}
CALL(REALIN) ↔ DACM PDX# ↔ DACN NDX# ;HALF WIDTH.
CALL(REALIN) ↔ DACM PDY# ↔ DACN NDY# ;HALF HEIGHT.
CALL(REALIN) ↔ DACM RADY#↔DACM RADX# ;ROUNDING RADIUS.
LAC X1,NDX↔LAC Y1,NDY↔FAD Y1,RADY
LAC X2,NDX↔LAC Y2,PDY↔FSB Y2,RADY↔CALL(MKSEG3) ;WEST.
LAC X1,PDX↔LAC Y1,NDY↔FAD Y1,RADY
LAC X2,PDX↔LAC Y2,PDY↔FSB Y2,RADY↔CALL(MKSEG3) ;EAST.
LAC X1,NDX↔FAD X1,RADX↔LAC Y1,NDY
LAC X2,PDX↔FSB X2,RADX↔LAC Y2,NDY↔CALL(MKSEG3) ;SOUTH.
LAC X1,NDX↔FAD X1,RADX↔LAC Y1,PDY
LAC X2,PDX↔FSB X2,RADX↔LAC Y2,PDY↔CALL(MKSEG3) ;NORTH.
;ROUND THE CORNERS.
LACI XFN↔DAP FN ;GIVE FUN ARG TO MKCURV.
PUSH P,SINE↔PUSH P,COSINE ;SAVE ORIGINAL ORIENTATION.
LAC ROW↔DAC R0#↔LAC COL↔DAC C0# ;SAVE ORIGINAL LOCATION.
LAC PDX↔FSBR RADX↔FIXX↔DAC DC#
LAC PDY↔FSBR RADY↔FIXX↔DAC DR#
SETZM SINE↔LAC[1.0]↔DAC COSINE
LAC R0↔SUB DR↔DAC ROW↔LAC C0↔ADD DC↔DAC COL↔CALL(SWNARC)
SETZM COSINE↔LAC[1.0]↔DAC SINE
LAC R0↔SUB DR↔DAC ROW↔LAC C0↔SUB DC↔DAC COL↔CALL(SWNARC)
SETZM SINE↔LAC[-1.0]↔DAC COSINE
LAC R0↔ADD DR↔DAC ROW↔LAC C0↔SUB DC↔DAC COL↔CALL(SWNARC)
SETZM COSINE↔LAC[-1.0]↔DAC SINE
LAC R0↔ADD DR↔DAC ROW↔LAC C0↔ADD DC↔DAC COL↔CALL(SWNARC)
;RESTORE THE GLOBALS
LAC R0↔DAC ROW↔ LAC C0↔DAC COL
POP P,COSINE↔POP P,SINE↔POP0J
XFN: LAC 1,ARG1↔FDV 1,RADX↔FMP 1,1
FADR 1,[-1.0]↔CALL(SQRT,1)↔FMP 1,RADY↔POP1J
SWNARC: SETZ X1,
LAC Y1,RADY↔LAC X2,RADX
SETZ Y2,0↔CALL(MKCURV)↔POP0J
ENDR XSWINE
SUBR(MKCURV)
;--------------------------------------------------------------------
ACCUMULATORS{X1,Y1,X2,Y2}
PUSH P,X1↔PUSH P,Y1
FADR X1,X2↔FSC X1,-1
FADR Y1,Y2↔FSC Y1,-1
CALL(FN,X1)↔EXCH 1,Y1
FSB 1,Y1↔MOVMS 1↔CAMGE 1,[1.5]↔GO L1
LAC 1,X1↔FSB 1,X2↔MOVMS 1↔CAMGE 1,[1.0]↔GO L1
CALL(MKCURV) ;MIDPOINT TO 2ND END.
LAC X2,-1(P)↔LAC Y2,0(P)
CALL(MKCURV) ;MIDPOINT TO 1ST END.
POP P,Y1↔POP P,X1↔POP0J
L1: LAC X1,-1(P)↔LAC Y1,0(P)
CALL(MKSEG3)
POP P,Y1↔POP P,X1↔POP0J
ENDR MKCURV;_________________________________________________________
END SA